PC Pro 2005 June (DVD)/DPPRO0605DVD.iso/Install/program files/Borland/BDS/3.0/Demos/Delphi.Net/CLR/MapQuest/PetrVones.Utils.SoapTrace.pas

Pascal/Delphi Source File | 2004-10-22 | 4.5 KB | 179 lines

unit PetrVones.Utils.SoapTrace;

// Reference:
// http://msdn.microsoft.com/library/en-us/cpref/html/frlrfSystemWebServicesProtocolsSoapExtensionClassTopic.asp

// Usage:
// Add [TraceExtensionAttribute] to each method you'd like to monitor in code generated by WSDL importer

interface

uses
  System.Xml, System.Web.Services, System.Web.Services.Protocols, System.IO;

type
  TSoapMessageEvent = procedure (Sender: TObject; const Xml: string) of object;

  TSoapMonitor = class(TObject)
  private
    FOnRequest: TSoapMessageEvent;
    FOnResponse: TSoapMessageEvent;
  protected
    procedure DoRequest(const Xml: string);
    procedure DoResponse(const Xml: string);
  public
    class function FormatXmlData(const Xml: string): string; static;
    property OnRequest: TSoapMessageEvent add FOnRequest remove FOnRequest;
    property OnResponse: TSoapMessageEvent add FOnResponse remove FOnResponse;
  end;

  [AttributeUsage(AttributeTargets.Method)]
  TraceExtensionAttribute = class(SoapExtensionAttribute)
  strict private
    FPriority: Integer;
  public
    function get_ExtensionType: System.Type; override;
    function get_Priority: Integer; override;
    procedure set_Priority(value: Integer); override;
  end;

function SoapMonitor: TSoapMonitor;

implementation

var
  Monitor: TSoapMonitor;

type
  TraceExtension = class(SoapExtension)
  strict private
    OldStream, NewStream: Stream;
    class procedure CopyStream(Source, Dest: Stream);
    function SoapContent: string;
  public
    function ChainStream(s: Stream): Stream; override;
    function GetInitializer(serviceType: System.Type): System.Object; override;
    function GetInitializer(methodInfo: LogicalMethodInfo; attribute: SoapExtensionAttribute): System.Object; override;
    procedure Initialize(initializer: System.Object); override;
    procedure ProcessMessage(message: SoapMessage); override;
  end;

function SoapMonitor: TSoapMonitor;
begin
  if not Assigned(Monitor) then
    Monitor := TSoapMonitor.Create;
  Result := Monitor;
end;

{ TraceExtension }

function TraceExtension.ChainStream(s: Stream): Stream;
begin
  OldStream := s;
  NewStream := MemoryStream.Create;
  Result := NewStream;
end;

class procedure TraceExtension.CopyStream(Source, Dest: Stream);
var
  Reader: TextReader;
  Writer: TextWriter;
begin
  Reader := StreamReader.Create(Source);
  Writer := StreamWriter.Create(Dest);
  Writer.WriteLine(Reader.ReadToEnd);
  Writer.Flush;
end;

function TraceExtension.GetInitializer(serviceType: System.Type): System.Object;
begin
  Result := nil;
end;

function TraceExtension.GetInitializer(methodInfo: LogicalMethodInfo; attribute: SoapExtensionAttribute): System.Object;
begin
  Result := nil;
end;

procedure TraceExtension.Initialize(initializer: System.Object);
begin
end;

procedure TraceExtension.ProcessMessage(message: SoapMessage);
begin
  case message.Stage of
    SoapMessageStage.AfterSerialize:
      begin
        Monitor.DoRequest(SoapContent);
        CopyStream(NewStream, OldStream);
      end;
    SoapMessageStage.BeforeDeserialize:
      begin
        CopyStream(OldStream, NewStream);
        Monitor.DoResponse(SoapContent);
      end;
  end;
end;

function TraceExtension.SoapContent: string;
var
  Reader: StreamReader;
begin
  NewStream.Position := 0;
  Reader := StreamReader.Create(NewStream);
  Result := Reader.ReadToEnd;
  NewStream.Position := 0;
end;

{ TSoapMonitor }

procedure TSoapMonitor.DoRequest(const Xml: string);
begin
  if Assigned(FOnRequest) then
    FOnRequest(Self, Xml);
end;

procedure TSoapMonitor.DoResponse(const Xml: string);
begin
  if Assigned(FOnResponse) then
    FOnResponse(Self, Xml);
end;

class function TSoapMonitor.FormatXmlData(const Xml: string): string;
var
  Doc: XmlDocument;
  Sw: StringWriter;
  Xw: XmlTextWriter;
begin
  Doc := XmlDocument.Create;
  Doc.LoadXml(Xml);
  Sw := StringWriter.Create;
  Xw := XmlTextWriter.Create(sw);
  Xw.Formatting := Formatting.Indented;
  Xw.Indentation := 2;
  Xw.IndentChar := ' ';
  doc.Save(xw);
  Result := sw.ToString;
  Xw.Close;
  Sw.Close;
end;

{ TraceExtensionAttribute }

function TraceExtensionAttribute.get_ExtensionType: System.Type;
begin
  Result := typeof(TraceExtension);
end;

function TraceExtensionAttribute.get_Priority: Integer;
begin
  Result := FPriority;
end;

procedure TraceExtensionAttribute.set_Priority(value: Integer);
begin
  FPriority := value;
end;

end.